home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vssexa1a / frmvss.frm next >
Text File  |  1999-08-27  |  10KB  |  366 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   7230
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   6585
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   7230
  10.    ScaleWidth      =   6585
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.Frame Frame2 
  13.       Caption         =   "Files"
  14.       Height          =   2415
  15.       Left            =   120
  16.       TabIndex        =   10
  17.       Top             =   4680
  18.       Width           =   6375
  19.       Begin VB.ListBox lstFiles 
  20.          Height          =   2010
  21.          Left            =   120
  22.          MultiSelect     =   2  'Extended
  23.          TabIndex        =   12
  24.          Top             =   240
  25.          Width           =   4575
  26.       End
  27.       Begin VB.CommandButton cmdGetFile 
  28.          Caption         =   "Get &File"
  29.          Enabled         =   0   'False
  30.          Height          =   495
  31.          Left            =   4920
  32.          TabIndex        =   11
  33.          Top             =   240
  34.          Width           =   1215
  35.       End
  36.    End
  37.    Begin VB.Frame Frame1 
  38.       Caption         =   "Projects"
  39.       Height          =   2415
  40.       Left            =   120
  41.       TabIndex        =   8
  42.       Top             =   2160
  43.       Width           =   6375
  44.       Begin VB.CommandButton cmdGetProject 
  45.          Caption         =   "Get &Project"
  46.          Enabled         =   0   'False
  47.          Height          =   495
  48.          Left            =   4920
  49.          TabIndex        =   14
  50.          Top             =   240
  51.          Width           =   1215
  52.       End
  53.       Begin VB.CheckBox chkSubFolders 
  54.          Caption         =   "Show files in sub folders"
  55.          Height          =   375
  56.          Left            =   4800
  57.          TabIndex        =   13
  58.          Top             =   1920
  59.          Width           =   1455
  60.       End
  61.       Begin VB.ListBox lstProjects 
  62.          Height          =   2010
  63.          Left            =   120
  64.          MultiSelect     =   2  'Extended
  65.          TabIndex        =   9
  66.          Top             =   240
  67.          Width           =   4575
  68.       End
  69.    End
  70.    Begin VB.CommandButton cmdExit 
  71.       Caption         =   "E&xit"
  72.       Height          =   495
  73.       Left            =   5040
  74.       TabIndex        =   7
  75.       Top             =   1440
  76.       Width           =   1215
  77.    End
  78.    Begin VB.CommandButton cmdOpen 
  79.       Caption         =   "&Open VSS"
  80.       Height          =   495
  81.       Left            =   240
  82.       TabIndex        =   6
  83.       Top             =   1440
  84.       Width           =   1215
  85.    End
  86.    Begin VB.TextBox txtPassword 
  87.       Height          =   285
  88.       IMEMode         =   3  'DISABLE
  89.       Left            =   2160
  90.       PasswordChar    =   "*"
  91.       TabIndex        =   5
  92.       Top             =   960
  93.       Width           =   4095
  94.    End
  95.    Begin VB.TextBox txtUserID 
  96.       Height          =   285
  97.       Left            =   2160
  98.       TabIndex        =   3
  99.       Top             =   600
  100.       Width           =   4095
  101.    End
  102.    Begin VB.TextBox txtINIPath 
  103.       Height          =   285
  104.       Left            =   2160
  105.       TabIndex        =   1
  106.       Top             =   240
  107.       Width           =   4095
  108.    End
  109.    Begin VB.Label Label2 
  110.       Alignment       =   1  'Right Justify
  111.       Caption         =   "Password:"
  112.       Height          =   255
  113.       Left            =   240
  114.       TabIndex        =   4
  115.       Top             =   960
  116.       Width           =   1695
  117.    End
  118.    Begin VB.Label Label1 
  119.       Alignment       =   1  'Right Justify
  120.       Caption         =   "User ID:"
  121.       Height          =   255
  122.       Left            =   240
  123.       TabIndex        =   2
  124.       Top             =   600
  125.       Width           =   1695
  126.    End
  127.    Begin VB.Label lblPath 
  128.       Alignment       =   1  'Right Justify
  129.       Caption         =   "srcsafe.ini Path:"
  130.       Height          =   255
  131.       Left            =   240
  132.       TabIndex        =   0
  133.       Top             =   240
  134.       Width           =   1695
  135.    End
  136. End
  137. Attribute VB_Name = "Form1"
  138. Attribute VB_GlobalNameSpace = False
  139. Attribute VB_Creatable = False
  140. Attribute VB_PredeclaredId = True
  141. Attribute VB_Exposed = False
  142. Option Explicit
  143. '*************************************************
  144. 'Date: 08/27/99 mg
  145. 'We have weekly (sometimes daily) builds of the
  146. 'software we are developing.  We have a build process
  147. 'that I have (for the most part) automated.  The only
  148. 'piece missing was the ability to interact with
  149. 'SourceSafe and get the files the developers wanted
  150. 'added to the build.  This project reads a source safe
  151. 'database and gets projects and files from it.  There
  152. 'is a MS article at
  153. ' http://msdn.microsoft.com/SSAFE/technical/articles/vssauto/VSSAuto.html
  154. 'that gives functionality
  155. 'possibilites that could be added.  If you have any
  156. 'questions, don't hesitate to send me an email.
  157. '*************************************************
  158.  
  159. Dim vsdb As New VSSDatabase
  160. Dim vsItem As VSSItem
  161. Dim loopItem As VSSItem
  162. Dim tabcount As Integer
  163. Dim vsProjects() As String
  164. Dim vsProjectSpecifics() As String
  165.  
  166. Private Sub cmdExit_Click()
  167.   Unload Me
  168.   End
  169. End Sub
  170.  
  171. Private Sub cmdGetFile_Click()
  172. Dim j%
  173.     '
  174.     'loop through the list to get all selected
  175.     '
  176.   For j = 0 To lstFiles.ListCount - 1
  177.     If lstFiles.Selected(j) = True Then
  178.         '
  179.         'set the db current project to the selected file
  180.         '
  181.       vsdb.CurrentProject = vsProjectSpecifics(j + 1)
  182.         '
  183.         'set the item
  184.         '
  185.       Set vsItem = vsdb.VSSItem(vsdb.CurrentProject, False)
  186.         '
  187.         'get the file
  188.         '
  189.       vsItem.Get
  190.     End If
  191.   Next 'j
  192. End Sub
  193.  
  194. Private Sub cmdGetProject_Click()
  195. Dim j%
  196.     '
  197.     'loop through the list to get all selected
  198.     '
  199.   For j = 0 To lstProjects.ListCount - 1
  200.     If lstProjects.Selected(j) = True Then
  201.         '
  202.         'set the db current project to the selected file
  203.         '
  204.       vsdb.CurrentProject = vsProjects(j + 1)
  205.         '
  206.         'set the item
  207.         '
  208.       Set vsItem = vsdb.VSSItem(vsdb.CurrentProject, False)
  209.         '
  210.         'get the project
  211.         '
  212.       vsItem.Get
  213.     End If
  214.   Next 'j
  215.  
  216. End Sub
  217.  
  218. Private Sub cmdOpen_Click()
  219. Dim tmp$
  220.     '
  221.     'open a connection to the emerald database
  222.     '
  223.   If Right$(txtINIPath.Text, 1) <> "\" Then
  224.     vsdb.Open txtINIPath.Text & "\srcsafe.ini", txtUserID.Text, txtPassword.Text
  225.   Else
  226.     vsdb.Open txtINIPath.Text & "srcsafe.ini", txtUserID.Text, txtPassword.Text
  227.   End If
  228.     
  229.     '
  230.     'look at the root project
  231.     '
  232.   vsdb.CurrentProject = "$/"
  233.   tabcount = -1
  234.   Call GetProjects(vsdb.CurrentProject)
  235.  
  236. End Sub
  237.  
  238. Sub GetProjectSpecifics(ProjectName$, Recursion As Boolean)
  239. Dim gpfItem As VSSItem
  240. Dim gpfLoop As VSSItem
  241. Dim tmp$
  242.  
  243.   tabcount = tabcount + 1
  244.  
  245.   Set gpfItem = vsdb.VSSItem(ProjectName$, False)
  246.     '
  247.     'loop thru the items and add the names to a list box
  248.     '
  249.   For Each gpfLoop In gpfItem.Items(False)
  250.  
  251.     tmp$ = String$(tabcount, Chr$(9))
  252.  
  253.     If gpfLoop.Type = VSSITEM_PROJECT Then
  254.         '
  255.         'add to the list and add to the project array
  256.         '
  257.       lstFiles.AddItem tmp$ & gpfLoop.Name
  258.       ReDim Preserve vsProjectSpecifics(UBound(vsProjectSpecifics) + 1)
  259.       vsProjectSpecifics(UBound(vsProjectSpecifics)) = gpfLoop.Spec
  260.       lstFiles.ItemData(lstFiles.NewIndex) = UBound(vsProjectSpecifics)
  261.       If Recursion = True Then
  262.           '
  263.           'loop through any folders in this folder
  264.           '
  265.         If Right$(ProjectName$, 1) = "/" Then
  266.           Call GetProjectSpecifics(ProjectName$ & gpfLoop.Name, Recursion)
  267.         Else
  268.           Call GetProjectSpecifics(ProjectName$ & "/" & gpfLoop.Name, Recursion)
  269.         End If
  270.       End If
  271.     ElseIf gpfLoop.Type = VSSITEM_FILE Then
  272.         '
  273.         'add to the list and add to the project array
  274.         '
  275.       lstFiles.AddItem tmp$ & gpfLoop.Name
  276.       ReDim Preserve vsProjectSpecifics(UBound(vsProjectSpecifics) + 1)
  277.       vsProjectSpecifics(UBound(vsProjectS